home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Frameworks / TransSkel 3.24 / Demos / Pascal Demos / ThreadDemo / ThreadDemo.p next >
Text File  |  1996-01-25  |  7KB  |  325 lines
  1. {
  2.     Threads - TransSkel Thread Manager demonstration application
  3.  
  4.     This is a very simple-minded demonstration. It puts up a single
  5.     window that draws a horizontal line, a vertical line, and an oval
  6.     whose horizontal and vertical axes are the same length as the current
  7.     lengths of the horizontal and vertical lines.  Each of the lines
  8.     and the oval are drawn independently, using three threads.  In order
  9.     to emphasize the independent nature of the three threads, the
  10.     graphical object draw by each updates at a different rate.
  11.  
  12.     23 Jul 95 Version 1.00, Paul DuBois
  13. }
  14.  
  15. program ThreadDemo;
  16.  
  17. uses
  18.     Types, Memory, SegLoad, Events, QuickDraw, Windows, Dialogs, Menus,
  19.     TextUtils, ToolUtils, Processes, Threads, TransSkel;
  20.  
  21. const
  22.  
  23. { resource numbers }
  24.  
  25.     aboutAlrtRes = 1000;                { About box }
  26.     errAlrtRes = 1001;                    { error alert }
  27.     fileMenuNum = skelAppleMenuID + 1;    { File menu }
  28.  
  29. { error string resource numbers }
  30.  
  31.     noThreadManager = 1000;
  32.     noThread = 1001;
  33.     
  34.     windowTitle = 'ThreadDemo';
  35.     windowWidth = 300;
  36.     windowHeight = 120;
  37.  
  38.     maxLineLen = 100;
  39.  
  40. { thread update times }
  41.  
  42.     thread1Update = 1;
  43.     thread2Update = 3;
  44.     thread3Update = 2;
  45.  
  46. { File menu item numbers }
  47.  
  48.     quit = 1;
  49.  
  50. var
  51.  
  52.     fileMenu: MenuHandle;
  53.  
  54.     length1: Integer;    { horizontal line length }
  55.     length2: Integer;    { vertical line length }
  56.  
  57.     refTime1: Longint;
  58.     delta1: Longint;
  59.     refTime2: Longint;
  60.     delta2: Longint;
  61.     refTime3: Longint;
  62.     rect3: Rect;
  63.  
  64.     time: Longint;
  65.     time2: Longint;
  66.  
  67. procedure
  68. Die (strNum: Integer);
  69. var
  70.     h: StringHandle;
  71.     flags: SignedByte;
  72.     ignore: Integer;
  73. begin
  74.     h := GetString (strNum);
  75.     if (h <> StringHandle (nil)) then
  76.         begin
  77.             flags := HGetState(Handle(h));
  78.             HLock (Handle (h));
  79.             ParamText(h^^, '', '', '');
  80.             HSetState (Handle(h), flags);
  81.         end
  82.     else
  83.         ParamText ('An unknown error occurred.', '', '', '');
  84.  
  85.     ignore := SkelAlert (errAlrtRes, SkelDlogFilter (nil, true),
  86.                                         skelPositionOnParentDevice);
  87.     SkelRmveDlogFilter;
  88.     SkelCleanup;
  89.     ExitToShell;
  90. end;
  91.  
  92.  
  93. {--------------------------------------------------------------------}
  94. { Menu handling procedures }
  95. {--------------------------------------------------------------------}
  96.  
  97. { Handle selection of "About Hello..." item from Apple menu }
  98.  
  99. procedure
  100. DoAppleMenu (item: Integer);
  101. var
  102.     ignore: Integer;
  103. begin
  104.     ignore := SkelAlert(aboutAlrtRes, SkelDlogFilter (nil, true),
  105.                                         skelPositionOnParentDevice);
  106.     SkelRmveDlogFilter;
  107. end;
  108.  
  109.  
  110. { Process selection from File menu }
  111.  
  112. procedure
  113. DoFileMenu (item: Integer);
  114. begin
  115.     case item of
  116.         quit: 
  117.             SkelStopEventLoop;
  118.     end;
  119. end;
  120.  
  121.  
  122. { Initialize menus.  Tell TransSkel to process the Apple menu }
  123. { automatically, and associate the proper procedure with the }
  124. { File menu. }
  125.  
  126. procedure
  127. SetupMenus;
  128. var
  129.     ignore: Boolean;
  130. begin
  131.     SkelApple ('About ThreadDemo…', @DoAppleMenu);
  132.     fileMenu := NewMenu (fileMenuNum, 'File');
  133.     AppendMenu (fileMenu, 'Quit/Q');
  134.     ignore := SkelMenu(fileMenu, @DoFileMenu, nil, false, false);
  135.  
  136.     DrawMenuBar;
  137. end;
  138.  
  139.  
  140. {--------------------------------------------------------------------}
  141. { Window handling procedures }
  142. {--------------------------------------------------------------------}
  143.  
  144.  
  145. procedure
  146. Clobber;
  147. var
  148.     w: WindowPtr;
  149. begin
  150.     GetPort (w);
  151.     DisposeWindow (w);
  152.     
  153.     { should really dispose of threads here }
  154. end;
  155.  
  156.  
  157. {--------------------------------------------------------------------}
  158. { Thread handling procedures }
  159. {--------------------------------------------------------------------}
  160.  
  161.  
  162. function
  163. DoThread1 (threadParam: Ptr): Ptr;
  164. var
  165.     ignore: OSErr;
  166. begin
  167.     while (true) do
  168.     begin
  169.         if (TickCount () >= refTime1) then
  170.             begin
  171.                 PenMode (patBic);
  172.                 MoveTo (60 - (maxLineLen div 2), 60);
  173.                 LineTo (60 + (maxLineLen div 2), 60);
  174.                 PenNormal;
  175.                 MoveTo (60 - (length1 div 2), 60);
  176.                 LineTo (60 + (length1 div 2), 60);
  177.                 if (delta1 > 0) then
  178.                     begin
  179.                         if (length1 >= maxLineLen) then
  180.                             delta1 := -delta1;
  181.                     end
  182.                 else
  183.                     begin
  184.                         if (length1 <= 0) then
  185.                             delta1 := -delta1;
  186.                     end;
  187.                 length1 := length1 + delta1;
  188.                 refTime1 := TickCount() + thread1Update;
  189.             end;
  190.         ignore := YieldToAnyThread;
  191.     end;
  192.     DoThread1 := nil;            { will never be reached }
  193. end;
  194.  
  195.  
  196. function
  197. DoThread2 (threadParam: Ptr): Ptr;
  198. var
  199.     ignore: OSErr;
  200. begin
  201.     while (true) do
  202.     begin
  203.         if (TickCount () >= refTime2) then
  204.             begin
  205.                 PenMode (patBic);
  206.                 MoveTo (150, 60 - (maxLineLen div 2));
  207.                 LineTo (150, 60 + (maxLineLen div 2));
  208.                 PenNormal;
  209.                 MoveTo (150, 60 - (length2 div 2));
  210.                 LineTo (150, 60 + (length2 div 2));
  211.                 if (delta2 > 0) then
  212.                     begin
  213.                         if (length2 >= maxLineLen) then
  214.                             delta2 := -delta2;
  215.                     end
  216.                 else
  217.                     begin
  218.                         if (length2 <= 0) then
  219.                             delta2 := -delta2;
  220.                     end;
  221.                 length2 := length2 + delta2;
  222.                 refTime2 := TickCount() + thread2Update;
  223.             end;
  224.         ignore := YieldToAnyThread;
  225.     end;
  226.     DoThread2 := nil;            { will never be reached }
  227. end;
  228.  
  229.  
  230. {
  231.     Draw an oval with the dimensions of the horizontal and vertical lines
  232.     being drawn in threads 1 and 2.
  233. }
  234.  
  235. function
  236. DoThread3 (threadParam: Ptr): Ptr;
  237. var
  238.     ignore: OSErr;
  239. begin
  240.     while (true) do
  241.     begin
  242.         if (TickCount () >= refTime3) then
  243.             begin
  244.                 EraseOval (rect3);
  245.                 SetRect (rect3, 0, 0, length1, length2);
  246.                 OffsetRect (rect3, 240 - (length1 div 2), 60 - (length2 div 2));
  247.                 FrameOval (rect3);
  248.                 refTime3 := TickCount() + thread3Update;
  249.             end;
  250.         ignore := YieldToAnyThread;
  251.     end;
  252.     DoThread3 := nil;            { will never be reached }
  253. end;
  254.  
  255.  
  256. { Create window and install handler for it. }
  257.  
  258. procedure
  259. WindInit;
  260. var
  261.     w: WindowPtr;
  262.     bounds: Rect;
  263.     ignore: Boolean;
  264.     dummyID: ThreadID;
  265. begin
  266.     SetRect (bounds, 0, 0, windowWidth, windowHeight);
  267.     if (SkelQuery (skelQHasColorQD) <> 0) then
  268.         w := NewCWindow (nil, bounds, windowTitle, false,
  269.                         noGrowDocProc, WindowPtr(-1), false, 0)
  270.     else
  271.         w := NewWindow (nil, bounds, windowTitle, false,
  272.                         noGrowDocProc, WindowPtr(-1), false, 0);
  273.     SkelPositionWindow (w, skelPositionOnMainDevice,
  274.                                     FixRatio(1, 2), FixRatio(1, 5));
  275.     ignore := SkelWindow (w, nil, nil, nil, nil, nil, @Clobber, nil, false);
  276.  
  277.     SelectWindow (w);
  278.     ShowWindow (w);
  279.     SkelDoUpdates;
  280.     SkelDoEvents (updateMask + activMask);
  281.  
  282.  
  283.     if (NewThread (kCooperativeThread, @DoThread1, nil, 0,
  284.                     kCreateIfNeeded, nil, dummyID) <> noErr) then
  285.     begin
  286.         Die (noThread);
  287.     end;
  288.     if (NewThread (kCooperativeThread, @DoThread2, nil, 0,
  289.                     kCreateIfNeeded, nil, dummyID) <> noErr) then
  290.     begin
  291.         Die (noThread);
  292.     end;
  293.     if (NewThread (kCooperativeThread, @DoThread3, nil, 0,
  294.                     kCreateIfNeeded, nil, dummyID) <> noErr) then
  295.     begin
  296.         Die (noThread);
  297.     end;
  298. end;
  299.  
  300.  
  301. begin
  302.     length1 := 0;
  303.     refTime1 := 0;
  304.     delta1 := 4;
  305.  
  306.     length2 := 0;
  307.     refTime2 := 0;
  308.     delta2 := 4;
  309.  
  310.     refTime3 := 0;
  311.     SetRect (rect3, 0, 0, 0, 0);
  312.  
  313.     SkelInit (nil);
  314.     if (SkelQuery (skelQHasThreads) = 0) then
  315.         Die (noThreadManager);
  316.     SetupMenus;
  317.     WindInit;
  318.     SkelGetWaitTimes (time, time2);            { set background wait time }
  319.     SkelSetWaitTimes (time, time);            { to same as foreground time }
  320.     SkelSetThreadTimes (1, 1);
  321.     SkelEventLoop;                            { loop 'til Quit selected }
  322.     SkelCleanup;                            { clean up }
  323. end.
  324.  
  325.